#!/usr/bin/env perl
use strict;

=head1 NAME

webcamService.pl - web service to load webcam images


=head1 SYNOPSIS

=head1 AUTHOR

Alexandre Masselot, C<< <alexandre dot masselot arobas framexpeditions dot com> >>


=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2007 Alexandre Masselot, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

use CGI qw(:standard);
use File::Basename;
use CGIUtils;
use Image::Magick;
use Time::localtime;
use File::Copy;

init();

if ( $query->param('action') eq 'list' ) {

	my $data = readData(
		showlast => $query->param('showlast')
		  || $properties{'show.last'},
		recentthan => $query->param('recentthan')
		  || 0,    #|| cookie('recentthan')|| 0,
		include => $query->param('include') || undef,
		exclude => $query->param('exclude') || undef,
		timeslice => $query->param('timeslice')
		  || $properties{'time.slice'}
		  || 60,
	);
	if ( lc( $query->param('out') ) eq 'json' ) {

		#		my $cookie=cookie( -name => 'recentthan',
		#						   -value => $data->{mtime},
		#						   -path => "$ENV{SCRIPT_NAME}",
		#						 );
		print $query->header(
			-type => 'text/plain',

			#-cookie => $cookie,
		);

		require JSON;
		my $json = JSON->new( pretty => 1 );
		print $json->objToJson($data);
		exit(0);
	}
}

if ( $query->param('action') eq 'panoramic' ) {

	my $data = buildPano(
		name  => $query->param('name'),
		scale => $query->param('scale'),
		crop  => $query->param('crop'),
		root  => $query->param('root') || "",
		index => $query->param('index'),
	);
	if ( lc( $query->param('out') ) eq 'json' ) {

		#		my $cookie=cookie( -name => 'recentthan',
		#						   -value => $data->{mtime},
		#						   -path => "$ENV{SCRIPT_NAME}",
		#						 );
		print $query->header(
			-type => 'text/plain',

			#-cookie => $cookie,
		);

		require JSON;
		my $json = JSON->new( pretty => 1 );
		print $json->objToJson($data);
		exit(0);
	}
}

if ( $query->param('action') eq 'cleanit' ) {
	die "cannot clean if no data.limit propety is set"
	  unless $properties{'data.limit'};

	my $data        = readData();
	my @sortedFiles = @{ $data->{files} };
	my $limit       = $properties{'data.limit'};
	my $tot;
	foreach (@sortedFiles) {
		$_ = $_->{filename};
		$tot += ( stat($_) )[7];
		if ( $tot > $limit ) {
			unlink $_;
			print "removing $_<br/>\n";
		}
	}
}

if($query->param('action') eq 'tagimage'){
	my $file=$properties{'data.dir'}."/".$query->param('file').".jpg";
	die "no file $file " unless -f $file;
	my $mtime=localtime((stat($file))[9]);
	my $tag=sprintf('%2.2d%2.2d%2.2d_%2.2d%2.2d%2.2d', $mtime->year-100, $mtime->mon+1, $mtime->mday, $mtime->hour, $mtime->min, $mtime->sec);
	my $new=$properties{'data.dir'}."/".$query->param('file')."_$tag.jpg";
	if(-f $new){
		print <<EOT;
Content-type: text/plain

$file -> $new (already copied)
EOT
		exit(0);		
	}
	
	copy($file, $new);
	print <<EOT;
Content-type: text/plain

$file -> $new
EOT
exit(0);
}

sub readData {
	my %hparams    = @_;
	my $showLast   = $hparams{showlast};
	my $recentThan = $hparams{recentthan};
	my $timeSlice  = $hparams{timeslice};
	my $include    = $hparams{include};
	my $exclude    = $hparams{exclude};
	my $onestamp   = $hparams{stamp};

	die "no data.dir properties" unless $properties{'data.dir'};

	my @files;

	if ($include) {
		my $path;
		foreach ( split /,/, $include ) {
			$path .= $properties{'data.dir'} . "/${_}_??????_??????.jpg ";
		}
		@files = glob($path);
	}
	else {
		my $path = $properties{'data.dir'} . "/*_??????_??????.jpg";
		@files = glob($path);
		if ($exclude) {
			$exclude =~ s/,/|/g;
			$exclude =~ s/\*/.*/;
			my $re = qr/^($exclude)_/;
			my @tmp;
			foreach (@files) {
				my $bn = basename($_);
				push @tmp, $_ unless $bn =~ $re;    #$re;
			}
			@files = @tmp;
		}
	}

	my %file2mtime;
	foreach (@files) {
		$file2mtime{$_} = ( stat $_ )[9];
	}
	my @sortedFiles = sort { $file2mtime{$b} <=> $file2mtime{$a} } @files;

	if ($recentThan) {
		foreach ( 0 .. ( scalar(@sortedFiles) - 1 ) ) {
			if ( $file2mtime{ $sortedFiles[$_] } <= $recentThan ) {

				#we hit an older file, remove all following
				splice @sortedFiles, $_, ( scalar(@sortedFiles) - $_ );
				last;
			}
		}
	}

	my %fileData;
	my %dates;
	my %counters;

	foreach my $f (@sortedFiles) {
		next unless basename($f) =~ /(.*?)_\d{6}_\d{6}/;
		my $label = basename($1);
		$counters{$label}++;
		next if $showLast and $counters{$label} > $showLast;

		my $fthumb = $f;
		$fthumb =~ s/\.(\w+)$/-thumbnail.$1/;
		unless ( (-f $fthumb) && (-s $fthumb) ) {    
			open( FD, ">$fthumb" );
			close FD;
			buildthumb(
				image     => $f,
				thumbnail => $fthumb,
				width     => $properties{'thumbnail.width'} || 100
			);
		}

		my %h = (
			mtime     => $file2mtime{$f},
			filename  => basename($f),
			path      => $f,
			thumbnail => basename($fthumb),
			label     => $label,
		);
		my $nbytes = -s $f;
		if ( $nbytes < 2**10 ) {
			$h{size} = $nbytes;
		}
		elsif ( $nbytes < 2**20 ) {
			$h{size} = int( $nbytes / 1024 ) . "K";
		}
		else {
			$h{size} = int( $nbytes / ( 2**20 ) ) . "M";
		}
		my $base = basename($f);
		if ( $base =~ /(.*)\.(.*)/ ) {
			$h{root} = $1;
			$h{type} = $2;
		}
		else {

			#should not happen to have a file withou extension but...
			$h{root} = $base;
			$h{type} = '';
		}
		my ( $date, $time, $stamp );
		if ( $base =~ /(.*)_(\d\d)(\d\d)(\d\d)_(\d\d)(\d\d)(\d\d)/ ) {

			#$label = $1;
		        my ($day,$month, $year)=($4,$3,$2);
			$date = ( $day + 0 ) . "/" . ( $month + 0 );
			my $totsec = $5 * 3600 + $6 * 60 + $7;
			$totsec = int( $totsec / $timeSlice ) * $timeSlice;
			$time   = sprintf(
				"%2.2d:%2.2d:%2.2d",
				( int( $totsec / 3600 ) ),
				( int( $totsec % 3600 / 60 ) ),
				( $totsec % 60 )
			);
			$stamp = "$date $time";
			$stamp =~ s/:00$//;
			next if $onestamp && $stamp ne $onestamp;
			$dates{ $year*+100*1000+ $month * 100 + $day + $totsec / ( 24 * 3600 ) } = $stamp;
		}
		else {
			$label = 'nolabel';
			$date  = '1/1';
			$time  = '0:0:0';
		}
		$h{date} = $date;
		$h{time} = $time;

		my $refile = $properties{'data.filename.urlregexp'};
		if ($refile) {
			$_ = $h{path};
			eval "$refile";
			$h{url} = $_;
			$_ = $h{path};
			s/\.(\w+)$/-thumbnail.$1/;
			eval "$refile";
			$h{urlthumbnail} = $_;

		}
		else {
			$h{url} = $h{path};
			$_ = $h{path};
			s/\.(\w+)$/-thumbnail.$1/;
			$h{urlthumbnail} = $_;
		}

		#$url=~s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
		$fileData{files}{$label}{stamped}{$stamp} = \%h;
		push @{ $fileData{files}{$label}{index} }, $stamp;
	}

	my $latestmtime;
	if (%fileData) {
		$latestmtime = $file2mtime{ $sortedFiles[0] };
	}
	else {
		$latestmtime = $recentThan || 0;
	}
	$fileData{mtime} = $latestmtime;

	my @tmp;
	push @tmp, $dates{$_} foreach ( reverse sort {$a <=> $b} (keys %dates) );
	$fileData{timestamps} = \@tmp;

	#delete $fileData{files};

	return \%fileData;
}

sub buildPano {
	my %hparams = @_;

	my $name  = $hparams{name}  || die "no name";
	my $crop  = $hparams{crop}  || die "no crop";
	my $scale = $hparams{scale} || die "no scale";
	my @idx = split( /,/, $hparams{index} );
	die "no index" unless @idx;
	my $root = $hparams{root} || $name;

	my %imagefiles;
	$imagefiles{"$root$_"} = 1 foreach (@idx);

	my $includes = join( ',', keys(%imagefiles) ) . "," . $name;
	my $data = readData(
		showlast   => 2,
		recentthan => 0,
		include    => $includes,
		timeslice  => $query->param('timeslice')
		  || $properties{'time.slice'}
		  || 60,
	);
	my $latestcompleteindex;
	my $nbimages = scalar( keys %imagefiles );

	foreach my $stamp ( @{ $data->{timestamps} } ) {
		my $cpt = 0;
		foreach ( keys %imagefiles ) {
			$cpt++
			  if exists( $data->{files}{$_} )
			  && exists( $data->{files}{$_}{stamped}{$stamp} );
		}
		if ( $cpt == $nbimages ) {
			$latestcompleteindex = $stamp;
			last;
		}
	}
	die "no complete panoramic [$name]" unless $latestcompleteindex;

	unless ( exists $data->{files}{$name}{stamped}{$latestcompleteindex} ) {
		my @tmp;
		my $tag =
		  $data->{files}{"$root$idx[0]"}{stamped}{$latestcompleteindex}
		  {filename};
		unless ( $tag =~ s/$root$idx[0]_// ) {
			die "could not apply $tag =~ s/$root$idx[0]_//";
		}
		my $dir =
		  dirname( $data->{files}{"$root$idx[0]"}{stamped}{$latestcompleteindex}
			  {path} );

		foreach my $i ( 0 .. $#idx ) {
			my $idx = $idx[$i];
			my $f   =
			  $data->{files}{"$root$idx"}{stamped}{$latestcompleteindex}{path};
			my $img  = Image::Magick->new();
			my $ftmp = $f;
			$ftmp =~ s/.jpg$/-tmp.jpg/;
			$img->Read($f);
			push @tmp, $ftmp;
			$img->Crop( geometry => $crop )
			  ;    #'120x178+9+25 ' );   #'157x238+25+25 ');
			$img->Write( "$dir/$root-sub$i" . "_$tag" );
			$img->Scale( geometry => $scale )
			  ;    #'150x178+0+0' );    #'202x238+0+0');
			$img->Write($ftmp);
		}

		my $img = Image::Magick->new();
		$img->Read(@tmp);
		my $montage =
		  $img->Montage( geometry => $scale, tile => scalar(@idx) . "x1" )
		  ;        #'120x178+0+0', tile => '9x1' );
		my $x = $montage->[0]->Write( "$dir/$root" . "_$tag" );
		unlink @tmp;
	}
	my $data = readData(
		stamp     => $latestcompleteindex,
		include   => "$root,$root-sub*",
		timeslice => $query->param('timeslice')
		  || $properties{'time.slice'}
		  || 60,
	);
	return $data;
}

sub buildthumb {
	my %hparams       = @_;
	my $imagefile     = $hparams{image} || die "no image parameter";
	my $thumbnailfile = $hparams{thumbnail} || die "no thumbnail parameter";
	my $wthumb        = $hparams{width} || 100;

	my ( $image, $x );
	$image = Image::Magick->new;
	$x     = $image->Read($imagefile);
	warn "$x" if "$x";
	my ( $h, $w ) = $image->Get( 'height', 'width' );
	$h = int( $wthumb * $h / $w );
	$image->Thumbnail( geometry => "$wthumb" . "x$h" );
	warn "$x" if "$x";
	$image->Write($thumbnailfile);
	warn "$x" if "$x";

}
